home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
A.C.E. 2
/
ACE CD 2.iso
/
FILES
/
UTILS
/
AMOSPRO3.DMS
/
AMOSPRO3.adf
/
Sample_Bank_Maker.AMOS
/
Sample_Bank_Maker.amosSourceCode
< prev
Wrap
AMOS Source Code
|
1993-03-16
|
31KB
|
1,195 lines
'-------------------------------------------------------------
' Sample Bank Maker
' by Fran�ois Lionet
' (c) 1992 Europress Software Ltd.
'-------------------------------------------------------------
' If called from the editor menu (with "GRAB" as command line)
' this program will grab the first sample bank from the
' current program, up to bank number 512
'-------------------------------------------------------------
Set Buffer 12
Close Editor
VER$="1.00"
' Never break out of the program !
Break Off
Dim MN$(70),FLAG(5)
Dim D$(12),R$(12),DIAL$(43)
Global MN$(),NMN,FLAG(),YMN,MNDOWN,BPIC
Global DIAL$()
Global XSLI,YSLI,SXSLI,SYSLI
Global XINF,YINF,SXINF,SYINF
Global XBANK,YBANK,SXBANK,SYBANK
Global MX,MY,MZ,MK
Global C0,C1,C2,C3,C4,C5,C6,C7,CA,CNA,ACT
Global BLOC,ALERT,PAL$
Global PBANK,LBANK,NBANK,BNAME$
Global CUSAM,SELSAM
Global SSL,ESL
Global CHANGED,BCHANGED,BGRBBED
Global CUNAME$,CUFREQ,CULEN,CUSTART,CUEND
Global XWAVE,YWAVE,SXWAVE,SYWAVE
Global XSTART,XEND,TITLE
Global BLOC,BCU
COM$=Command Line$
C0=6 : C1=6 : C2=2 : C3=7 : C4=3 : C5=4 : C6=4 : C7=1
BCU=65502
BPIC=65500 : MNDOWN=39
N=20 : Repeat : N=N+1 : Read MN$(N) : Until MN$(N)="End" : NMN=N-1 : _SET_FLAGS
Data " 02384016064052_GSAM"," 03384068064052_PSAM"
Data "/ 04624016000000_SL"," 05624104016008_DN"," 06624112016008_UP"
Data "/ 99000016000000_SSt","/ 99192016000000_SEnd"
Data "/ 99448032176088_BNAME"
Data "/ 07000120000000"
Data " 09000136128008_3plus"," 10000144128008_2Plus"," 32000152128008_1Plus"," 11000160000000"," 33000176128008_1Minus"," 1200018412808_2Minus"," 13000192128008_3Minus"
Data " 14128136016016_STM"," 15144136016016_STP"," 16160136000000"
Data " 34128152016016_ENM"," 35144152016016_ENP"," 36160152000000"
Data " 17128168128032_Hear"
Data " 18256136064032_SLoad"
Data " 19320136064032_SSave"
Data " 20256168064032_SName"
Data " 21320168064032_SClr"
Data " 22448136064032_BLoad"
Data " 23512136064032_BSave"
Data " 24576136064032_BSavas"
Data " 25448168064032_BClr"
Data " 26512168064032_BIns"
Data " 27576168064032_BDel"
Data " 28384136000000"
Data " 29000000000000"," 30384000064016_MNQUIT"," 31448000000000"
Data "End"
DIAL$(1)="Free chip:"
DIAL$(2)="Free fast:"
DIAL$(3)="Empty"
DIAL$(4)="Bank: "
DIAL$(5)="not named"
DIAL$(6)="Current sample: "
DIAL$(7)=" - Length:"
DIAL$(8)=" Hertz "
DIAL$(9)="St :"
DIAL$(10)="End:"
DIAL$(11)="Current sample not saved into bank. Continue?"
DIAL$(12)="Please enter new sample name (8 letters)"
DIAL$(13)="Then press <RETURN>"
DIAL$(14)="Erase sample number"
DIAL$(15)="Saving sample number"
DIAL$(16)="Caution. Save has failed. The file on the disc is *not* valid!"
DIAL$(17)="Please enter a sample bank name"
DIAL$(18)=" already exists. Overwrite it? "
DIAL$(19)="Please choose a sample bank"
DIAL$(20)="Current bank not saved. Proceed anyway?"
DIAL$(21)="No bank to save!"
DIAL$(22)=">>> Loading IFF sample <<<"
DIAL$(23)=">>> Loading raw data <<<"
DIAL$(24)="Error while accessing disc."
DIAL$(25)="No sample to save!"
DIAL$(26)="Save an IFF sample"
DIAL$(27)="Please choose a name"
DIAL$(28)=">>> Saving IFF sample <<<"
DIAL$(29)="Load an IFF or raw sample"
DIAL$(30)="AMOS Professional Sample Bank Maker"
DIAL$(31)="Version "+VER$
DIAL$(32)="By Fran�ois Lionet"
DIAL$(33)="Copyright 1992 Europress Software Ltd."
DIAL$(34)="Out of memory: could not load all the samples."
DIAL$(35)="This bank is not a sample bank!"
DIAL$(36)="Error while loading."
DIAL$(37)="Warning, low memory state!"
DIAL$(38)="Out of memory."
DIAL$(39)=" Press mousekey to go on."
DIAL$(40)=": cannot load more samples."
DIAL$(41)="- GRABBED -"
DIAL$(42)="Copy bank to previous program?"
DIAL$(43)="Quit Sample Bank Maker. Sure?"
Global LMBANK
LMBANK=65501
_INIT_WORK
' Some things to grab?
If COM$="GRAB"
_GRAB_FIND["Samples "]
If Param
_DEL_BANK
_GRAB_BANK[Param]
BNAME$="" : CUSAM=0 : SELSAM=0 : BCHANGED=0 : BGRBBED=1
_DISPLAY_BANK : _DISPLAY_BNAME
End If
End If
' Main loop
ALERT=1
Do
Repeat
_MOUSE
If FMK : MK=FMK : MZ=FMZ : MX=FMX : MY=FMY : FMK=FMK2 : FMK2=0 : FMZ=FMZ2 : End If
If ALERT
ALERT=ALERT-1
If ALERT=0 : _INFO[""] : End If
End If
Until MK<>0 and MZ<>0
If TITLE : TITLE=0 : _DISPLAY_CSAM : End If
MFLAG=0
Do
MFLAG=MFLAG+1
If MZ<>0 and MFLAG=1
If MZ<=NMN
A$=Left$(MN$(MZ),1) : B$="" : Z=MZ
If A$<>"/"
If A$=" "
If BREL<>MZ : BREL=MZ : _DISPLAY_MN[MZ,1] : End If
Else
C$=Upper$(A$) : D$=Lower$(A$)
If(C$<>A$) or(D$<>A$)
If A$="F" : B$="f" : STATE=0 : End If
If A$="f" : B$="F" : STATE=1 : End If
If B$=""
B$=C$
For N=1 To NMN
If Left$(MN$(N),1)=C$
Left$(MN$(N),1)=D$ : _DISPLAY_MN[N,0]
End If
Next
End If
End If
End If
If B$<>"" : Left$(MN$(MZ),1)=B$ : _DISPLAY_MN[MZ,-1] : End If
G$="" : P=Instr(MN$(MZ),"_") : If P : G$=Mid$(MN$(MZ),P) : End If
If G$<>"" : Gosub G$ : End If
Else
G$="" : P=Instr(MN$(MZ),"_") : If P : G$=Mid$(MN$(MZ),P) : End If
If G$<>"" : Gosub G$ : End If
End If
End If
End If
OMK=MK : OMZ=MZ : _MOUSE
If MK=0 : Exit : End If
If MZ<>OMZ : Exit : End If
Loop
If BREL : _DISPLAY_MN[BREL,0] : BREL=0 : End If
Loop
'------------------
' Quit
_MNQUIT:
If BGRBBED
_DIALOG[DIAL$(43),"",0] : F=Param
If F
_DIALOG[DIAL$(42),"",0] : F=Param
If F
_GRAB_SEND[NBANK]
If Param
PQUIT
Else
_DIALOG[DIAL$(38),"",1]
End If
Else
PQUIT
End If
End If
Else
F=-1 : If BCHANGED : _DIALOG[DIAL$(20),"",0] : F=Param : End If
If F : _DEL_BANK : PQUIT : End If
End If
Return
'------------------
' Transfert to work
_GSAM:
_LOOSE_SAM
If Param
If SELSAM>0 and SELSAM<=LBANK+1
_GET_SAM[SELSAM] : Gosub _HEAR : _DISPLAY_CSAM : ALERT=1
_DISPLAY_BANK : ALERT=1
End If
End If
Return
'------------------
' Transfert to bank
_PSAM:
F=1
If CULEN>0
If SELSAM>0 and SELSAM<=LBANK+1
If SELSAM<>CUSAM
SB_START[SELSAM]
If Param
_DIALOG[DIAL$(14)+Str$(SELSAM)+" ?","",0] : F=Param
End If
End If
If F
_PUT_SAM[SELSAM]
If SELSAM=LBANK+1
If LBANK<126
LBANK=LBANK+1
If SELSAM=PBANK+SYBANK-1 : PBANK=PBANK+1 : End If
SELSAM=SELSAM+1
End If
End If
_DISPLAY_BANK : ALERT=1 : BCHANGED=1
End If
End If
End If
Return
'------------------
' Insert Empty
_BINS:
If LBANK<127
If SELSAM>0 and SELSAM<LBANK+1
SB_INSERT[SELSAM]
LBANK=LBANK+1 : _DISPLAY_BANK : ALERT=1 : BCHANGED=1
End If
End If
Return
'------------------
' Delete sample
_BDEL:
If SELSAM>0 and SELSAM<LBANK+1
F=-1 : SB_START[SELSAM]
If Param : _DIALOG[DIAL$(14)+Str$(SELSAM),"",0] : F=Param : End If
If F
SB_DELETE[SELSAM]
LBANK=LBANK-1 : If PBANK>1 and LBANK+1-PBANK<SYBANK : PBANK=PBANK-1 : End If
_DISPLAY_BANK : ALERT=1 : BCHANGED=1
End If
End If
Return
'------------------
' Clr bank
_BCLR:
F=-1
If BCHANGED
_DIALOG[DIAL$(20),"",0] : F=Param
End If
If F
_DEL_BANK : ALERT=1 : _DISPLAY_BANK : _DISPLAY_BNAME
End If
Return
'------------------
' Load sample
_SLOAD:
F=-1 : If CULEN : _LOOSE_SAM : F=Param : End If
If F
_FSEL["**",DIAL$(29),DIAL$(27)] : F$=Param$
If F$<>""
_LOAD_CSAM[F$] : E=Param
End If
End If
_DISPLAY_CSAM
If E=0 : ALERT=1 : End If
Return
'------------------
' Save sample
_SSAVE:
F=-1
If CULEN
_FSEL["**",DIAL$(26),DIAL$(27)] : F$=Param$
If F$<>""
F=-1
If Exist(F$) : _DIALOG[Right$(F$,20)+DIAL$(18),"",0] : F=Param : End If
If F : _SAVE_CSAM[F$] : End If
End If
Else
_INFO[DIAL$(25)] : ALERT=100
End If
Return
'------------------
' Clr sample
_SCLR:
If CULEN
_LOOSE_SAM
If Param
_CSAM_CLR : _DISPLAY_CSAM : ALERT=1
End If
End If
Return
'------------------
' Change name
_SNAME:
If CULEN
YY=8 : _UNPACK_DIALOG[YY*8,4]
Paper C1 : Pen C3 : Print At(5,YY+1);DIAL$(12) : Print At(5,YY+3);DIAL$(13);
Pen C4 : _LEDIT[CUNAME$,640,60,YY+2,8]
If Param$<>"_Esc_"
CUNAME$=Right$(Param$-" ",8)
If Len(CUNAME$)<8 : CUNAME$=CUNAME$+String$(" ",8-Len(CUNAME$)) : End If
End If
_ERASE_DIALOG : _DISPLAY_CNAME
End If
Return
'------------------
' Load a bank
_BLOAD:
F=-1
If BCHANGED
_DIALOG[DIAL$(20),"",0] : F=Param
End If
If F
F=0 : _FSEL["*.Abk",DIAL$(19),""] : F$=Param$
If F$<>""
F=-1 : _DEL_BANK : _LOAD_BANK[F$,1] : If Param : BNAME$=F$ : CUSAM=0 : SELSAM=0 : BCHANGED=0 : End If
End If
End If
If F=0 : _NOT_DONE : End If
_DISPLAY_BANK : _DISPLAY_BNAME
Return
' Save as
_BSAVAS:
If LBANK
_FSEL["*.Abk",DIAL$(17),""] : F$=Param$
If F$<>""
F=-1
If Exist(F$) : _DIALOG[Right$(F$,20)+DIAL$(18),"",0] : F=Param : End If
If F : BNAME$=F$ : _SAVE_BANK[BNAME$] : BCHANGED=0 : End If
_DISPLAY_BNAME
End If
If F=0 : _NOT_DONE : End If
Else
_INFO[DIAL$(21)] : ALERT=100
End If
Return
' Save
_BSAVE:
If LBANK
ALERT=1
If BNAME$="" : _FSEL["*.Abk",DIAL$(17),""] : BNAME$=Param$ : End If
If BNAME$<>"" : _SAVE_BANK[BNAME$] : BCHANGED=0 Else _NOT_DONE : End If
_DISPLAY_BNAME
Else
_INFO[DIAL$(21)] : ALERT=100
End If
Return
'------------------
' Click into names
_BNAME:
Z=MY/8-YBANK : S=PBANK+Z : SS=SELSAM
If S=SS
If Timer<25 : Goto _GSAM : End If
Else
If SS>0 : SELSAM=-1 : _DISPLAY_BSAM[SS] : End If
If S<=LBANK+1 : SELSAM=S : _DISPLAY_BSAM[S] : End If
End If
Timer=0
Return
'------------------
' Frequency
_1PLUS: D=1 : Goto _PLUS
_2PLUS: D=10 : Goto _PLUS
_3PLUS: D=100 : Goto _PLUS
_1MINUS: D=-1 : Goto _PLUS
_2MINUS: D=-10 : Goto _PLUS
_3MINUS: D=-100 : Goto _PLUS
_PLUS:
If CULEN
CUFREQ=CUFREQ+D
CUFREQ=Max(CUFREQ,600)
CUFREQ=Min(CUFREQ,32000)
If MK=2 : MFLAG=0 : End If
_DISPLAY_CUFREQ : Gosub _HEAR
CHANGED=1
End If
Return
'------------------
' Start / End of play
_STP: DS=2 : DE=0 : Goto _STK
_STM: DS=-2 : DE=0 : Goto _STK
_ENP: DS=0 : DE=2 : Goto _STK
_ENM: DS=0 : DE=-2 : Goto _STK
_STK: Gosub _SUB : Gosub _HEAR : If MK=2 : MFLAG=0 : End If : Return
_SST: Z=-1 : Goto _ST
_SEND: Z=0 : Goto _ST
_ST:
If CULEN
Repeat
_MOUSE : X=MX-XWAVE
If Z
DS=(X*CULEN)/SXWAVE-CUSTART : DE=0
Else
DE=(X*CULEN)/SXWAVE-CUEND : DS=0
End If
Gosub _SUB
If MK=2 : Gosub _HEAR : End If
Wait 5
Until MK=0
Gosub _HEAR
End If
Return
_SUB:
S=Max(CUSTART+DS,0) and $FFFFFFFE
E=Min(CUEND+DE,CULEN) and $FFFFFFFE
If E-S>256 : CUSTART=S : CUEND=E : _DISPLAY_CUSTART : CHANGED=1 : End If
Return
'------------------
' Hear sample
_HEAR:
If CULEN
Sam Raw 15,Start(BCU)+CUSTART,Max(512,CUEND-CUSTART),CUFREQ
End If
Return
'------------------
' Scrolling icons
_UP: If PBANK+SYBANK<=LBANK+1 : _SCROLL_UP : End If : Return
_DN: If PBANK>1 : _SCROLL_DOWN : End If : Return
'---------------
' Bank slider
_SL:
If MY<SSL or MY>ESL
If MY<SSL : If PBANK>1 : _SCROLL_DOWN : End If : End If
If MY>ESL : If PBANK<=LBANK-SYBANK : _SCROLL_UP : End If : End If
If MK=2 : MFLAG=0 : End If
Else
DY=MY-SSL : _DISPLAY_SLIDER[C7]
Repeat
_MOUSE
Y=MY-YSLI-DY : P=(Y*(LBANK+1))/SYSLI+1
If P<=0 : P=1 : End If
If P>LBANK-SYBANK+2 : P=LBANK-SYBANK+2 : End If
If P<>PBANK : PBANK=P : _DISPLAY_SLIDER[C7] : End If
Until MK=0
_DISPLAY_BANK
End If
Return
Procedure _INIT_WORK
Screen Open 0,640,200,8,Hires
Curs Off : Flash Off
For C=0 To 7 : Colour C,0 : Next : Wait Vbl
Cls 0 : Cls C1,288,4 To 352,SYWORK-4
XSLI=628 : YSLI=18 : SXSLI=8 : SYSLI=83
XINF=8 : YINF=124 : SXINF=624 : SYINF=8
XBANK=56 : YBANK=4 : SXBANK=22 : SYBANK=11
XWAVE=0 : YWAVE=68 : SXWAVE=384 : SYWAVE=52
Reserve Zone NMN
YMN=0
For N=1 To NMN
_DISPLAY_MN[N,0]
A$=Left$(MN$(N),1) : If(A$>="A") and(A$=<"Z") : _DISPLAY_MN[N,1] : End If
Next
Paper C1 : Pen C4
Locate XBANK,YBANK-2 : Print " Num Name Bytes "
Locate XBANK,YBANK-1 : Print "----------------------"
_DEL_BANK : _DISPLAY_BANK : _DISPLAY_BNAME
_CSAM_CLR
Ink C3,0
Text 24,48,DIAL$(30)
Text 24,56,DIAL$(31)
Text 24,72,DIAL$(32)
Text 24,88,DIAL$(33)
TITLE=100
Fade 1,$0,$E0E,$77,$FFF,$F00,$EE,$AA,$EEC
Limit Mouse
End Proc
Procedure _DISPLAY_MN[N,F]
If MN$(N)<>""
If F<0
F=0 : A$=Left$(MN$(N),1) : If(A$>="A") and(A$=<"Z") : F=1 : End If
End If
I=Val(Mid$(MN$(N),3,2))
X=Val(Mid$(MN$(N),5,3)) : Y=Val(Mid$(MN$(N),8,3))+YMN
TX=Val(Mid$(MN$(N),11,3)) : TY=Val(Mid$(MN$(N),14,3))
If I
If F=0
If I<90
_UNPACK[I,X,Y]
Else
G$="_D"+Mid$(Str$(I),2) : Gosub G$
End If
Else
If I<90
_UNPACK[I+MNDOWN,X,Y]
Else
Screen Copy 0,X+2,Y+1,X+TX,Y+TY To 0,X,Y
Cls 0,X+TX-2,Y To X+TX,Y+TY
Cls 0,X,Y+TY-1 To X+TX,Y+TY
End If
End If
If TX<>0 : Set Zone N,X,Y To X+TX,Y+TY : End If
End If
End If
Pop Proc
_D99: Return
End Proc
Procedure _UNPACK[N,X,Y]
Global BPIC
A=Start(BPIC)+Deek(Start(BPIC)+2*(N-1))
Unpack A,X,Y
End Proc
Procedure _MOUSE
Multi Wait
MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse) : MZ=Zone(MS,MX,MY)
MK=Mouse Key : If MK>3 : MK=3 : End If
End Proc
Procedure _WAIT_NOMK
If FWT
Wait FWT : FWT=0
Else
Wait Vbl : While Mouse Key : Wend
End If
End Proc
Procedure _WAIT_MK
While Inkey$<>"" : Wend
Repeat : _MOUSE : Until Inkey$<>"" or MK<>0
End Proc
Procedure _SET_FLAGS
For N=1 To NMN : If Upper$(Left$(MN$(N),1))="F" : _SET_FLAG[MN$(N)] : End If : Next
End Proc
Procedure _SET_FLAG[A$]
V=Asc(Mid$(A$,2,1))-65
FLAG(V)=0 : If Left$(A$,1)="F" : FLAG(V)=1 : End If
End Proc
Procedure _LOAD_CSAM[N$]
On Error Proc _DISC_ERROR
Resume Label _ERR
_CSAM_CLR : CUNAME$=""
If Chip Free+Fast Free<32*1024
_INFO[">>> "+DIAL$(38)+DIAL$(40)+" <<<"] : ALERT=200 : E=-1
Else
A=1
Do
B=Instr(N$,":",A)
If B=0
B=Instr(N$,"/",A) : If B=0 : Exit : End If
End If
A=B+1
Loop
Repeat
C$=Mid$(N$,A,1)
If(C$=".") or(C$="") : Exit : End If
CUNAME$=CUNAME$+C$
A=A+1
Until Len(CUNAME$)>=8
Open In 1,N$
A$=Input$(1,12)
If(Left$(A$,4)="FORM") and(Right$(A$,4)="8SVX")
_INFO[DIAL$(22)]
Do
A$=Input$(1,8)
PCHUNK=Pof(1) : LCHUNK=Leek(Varptr(A$)+4)
If Left$(A$,4)="VHDR"
B$=Input$(1,LCHUNK) : A=Varptr(B$)
CULEN=Leek(A)+Leek(A+4)
CUFREQ=Deek(A+12)
LCHUNK=0
End If
If Left$(A$,4)="NAME"
B$=Input$(1,LCHUNK) : CUNAME$=""
For N=1 To 8
C$=Mid$(B$,N,1) : If(C$<" ") or(C$>Chr$(127)) : C$=" " : End If
CUNAME$=CUNAME$+C$
Next
LCHUNK=0
End If
If Left$(A$,4)="BODY"
Exit
End If
If LCHUNK : Pof(1)=PCHUNK+LCHUNK : End If
Loop
Else
_INFO[DIAL$(23)]
Pof(1)=0 : CULEN=Lof(1) : CUFREQ=8363
End If
If CULEN
CULEN=CULEN and $FFFFFFFE
Reserve As Chip Work BCU,CULEN
SZ=CULEN : AC=Start(BCU) : P=0
While P<SZ
L=Min(1024,SZ-P)
A$=Input$(1,L)
Copy Varptr(A$),Varptr(A$)+L To AC+P
P=P+L
Wend
CUSTART=0 : CUEND=CULEN
E=0
End If
End If
Close : Goto _END
_ERR: E=-1 : _CSAM_CLR
_END:
End Proc[E]
Procedure _SAVE_CSAM[N$]
On Error Proc _DISC_ERROR
Resume Label _ERR
_INFO[DIAL$(28)]
Open Out 1,N$
H$="FORM"+" "+"8SVX" : Print #1,H$;
A$="VHDR"+String$(Chr$(0),4+20) : A=Varptr(A$) : Loke A+4,20
Loke A+8,CUEND-CUSTART : Doke A+8+12,CUFREQ
Poke A+8+14,1 : Loke A+8+16,$10000
Print #1,A$;
A$="NAME"+String$(Chr$(0),12) : Loke Varptr(A$)+4,8
Copy Varptr(CUNAME$),Varptr(CUNAME$)+8 To Varptr(A$)+8
Print #1,A$;
SZ=CUEND-CUSTART : A$=" BODY" : Loke Varptr(A$)+4,SZ : Print #1,A$;
P=0 : AC=Start(BCU)+CUSTART : A$=String$(" ",1024)
While P<SZ
L=Min(1024,SZ-P)
Copy AC+P,AC+P+L To Varptr(A$)
Print #1,Left$(A$,L);
P=P+L
Wend
If(SZ and 1) : Print #1,Chr$(0); : End If
Loke Varptr(H$)+4,Lof(1)-8
Pof(1)=0 : Print #1,H$;
Close : E=0 : ALERT=1 : Goto _END
_ERR: _INFO[DIAL$(16)] : ALERT=100 : E=-1
_END:
End Proc[E]
Procedure _LOAD_BANK[N$,ST]
On Error Proc _DISC_ERROR
Resume Label _ERR
Open In 1,N$
A$=Input$(1,4) : If A$<>"AmBk" : _DIALOG[DIAL$(35),"",1] : Goto _ERR : Pop Proc : End If
A$=Input$(1,2) : NBANK=Deek(Varptr(A$))
A$=Input$(1,6)
A$=Input$(1,8) : If A$<>"Samples " : _DIALOG[DIAL$(35),"",1] : Goto _ERR : End If
A$=Input$(1,2) : NN=Deek(Varptr(A$))
OF$=Input$(1,4) : L=Leek(Varptr(OF$)) : If L>6 : OF$=OF$+Input$(1,L-6) : End If
NB=0
For N=1 To NN
_INFO[">>> Loading sample #"+Str$(N+ST-1)+" <<<"]
If Leek(Varptr(OF$)+(N-1)*4)
S$=Input$(1,14)
SZ=Leek(Varptr(S$)+10)
If Chip Free+Fast Free<32*1024 : Bell : _INFO[DIAL$(34)+DIAL$(39)] : _WAIT_MK : Exit : End If
SB_RESERVE[N+ST-1,SZ+16,0] : If Param=0 : Bell : _INFO[DIAL$(34)+DIAL$(39)] : _WAIT_MK : Exit : End If
AC=Param
For C=1 To 14 : Poke AC,Asc(Mid$(S$,C,1)) : AC=AC+1 : Next
P=0
While P<SZ
L=Min(1024,SZ-P)
A$=Input$(1,L)
Copy Varptr(A$),Varptr(A$)+L To AC+P
P=P+L
Wend
End If
NB=NB+1
Next
Close 1
LBANK=LBANK+NB
BCHANGED=0
Goto _END
_ERR: Close : _DEL_BANK : NB=0
_END:
End Proc[NB]
Procedure _SAVE_BANK[N$]
On Error Proc _DISC_ERROR
Resume Label _ERR
Open Out 1,N$
ST$=Mid$("AmBk Samples ",1) : Print #1,ST$;
OF$=String$(" ",LBANK*4+2) : OF=Len(OF$) : Print #1,OF$;
For N=1 To LBANK
_INFO[">>> "+DIAL$(15)+Str$(N)+" <<<"]
SB_START[N]
If Param
Loke Varptr(OF$)+2+(N-1)*4,OF
AC=Param : SZ=Leek(AC+10)+14
P=0 : A$=String$(" ",1024)
While P<SZ
L=Min(1024,SZ-P)
Copy AC+P,AC+P+L To Varptr(A$)
Print #1,Left$(A$,L);
P=P+L
Wend
OF=OF+SZ : If(OF and 1) : OF=OF+1 : Print #1,Chr$(0); : End If
Else
Loke Varptr(OF$)+2+(N-1)*4,0
End If
Next
Pof(1)=0
Doke Varptr(ST$)+4,NBANK : Doke Varptr(ST$)+6,0 : Loke Varptr(ST$)+8,$80000008+OF
Print #1,ST$;
Doke Varptr(OF$),LBANK : Print #1,OF$;
Close 1 : BCHANGED=0 : ALERT=1 : Goto _END
_ERR: _INFO[DIAL$(16)] : ALERT=100
_END:
End Proc
Procedure _DISPLAY_SLIDER[C]
Reset Zone 23
Cls C0,XSLI,YSLI To XSLI+SXSLI,YSLI+SYSLI
If LBANK>=SYBANK
SSL=YSLI+(SYSLI*(PBANK-1))/LBANK
ESL=Min(YSLI+SYSLI,SSL+(SYSLI*SYBANK)/LBANK)
Cls C,XSLI,SSL To XSLI+SXSLI,ESL
Set Zone 23,XSLI,YSLI To XSLI+SXSLI,YSLI+SYSLI
End If
End Proc
Procedure _DISPLAY_BANK
For N=PBANK To PBANK+SYBANK : _DISPLAY_BSAM[N] : Next
_DISPLAY_SLIDER[C6]
End Proc
Procedure _DISPLAY_BSAM[N]
NN=N-PBANK
If NN>=0 and NN<SYBANK
Locate XBANK,YBANK+NN
If SELSAM<>N
Paper C1
Else
Paper C2
End If
Print " ";
Pen C4 : Locate XBANK+1, : Print Mid$(Str$(N),2);
If N<=LBANK+1
Pen C3 : Locate XBANK+5,YBANK+NN
SB_START[N] : A=Param
If A
A$=String$(" ",8) : Copy A,A+8 To Varptr(A$) : Print A$;
L=Leek(A+10) : Locate XBANK+14, : Print L;
Else
Print DIAL$(3);
End If
End If
End If
End Proc
Procedure _DISPLAY_BNAME
A$=DIAL$(4)
If BGRBBED
A$=A$+DIAL$(41)
Else If BNAME$=""
A$=A$+DIAL$(5)
Else
A$=A$+Right$(BNAME$,16)
End If
Cls C1,472,4 To 636,12
Ink C3,C1 : Text 456,10,A$
End Proc
Procedure _LOOSE_SAM
F=-1
If CHANGED
_DIALOG[DIAL$(11),"",0]
If Param=0 : _NOT_DONE : F=0 : End If
End If
End Proc[F]
Procedure _NOT_DONE
_INFO[">>> Not done <<<"] : ALERT=100
End Proc
Procedure _GET_SAM[S]
_CSAM_CLR
SB_START[S] : A=Param
If A
CUNAME$=""
For C=0 To 7
P=Peek(A+C) : If P<32 or P>127 : P=32 : End If
CUNAME$=CUNAME$+Chr$(P)
Next
CUFREQ=Deek(A+8)
CUSTART=0 : CULEN=Leek(A+10) and $FFFFFFFE : CUEND=CULEN
Erase BCU : Reserve As Chip Work BCU,CULEN
Copy A+14,A+14+CULEN To Start(BCU)
End If
CUSAM=S : CHANGED=0
End Proc
Procedure _PUT_SAM[N]
S=CUEND-CUSTART
If Chip Free+Fast Free<32*1024 : _DIALOG[DIAL$(38),"",1] : Pop Proc : End If
If S
SB_RESERVE[N,S+16,0] : A=Param
If A
Copy Varptr(CUNAME$),Varptr(CUNAME$)+8 To A
Doke A+8,CUFREQ : Loke A+10,S
Copy Start(BCU)+CUSTART,Start(BCU)+CUEND To A+14
CHANGED=0
Else
Bell : _WAIT_NOMK
_INFO[">>> "+DIAL$(38)+DIAL$(39)+" <<<"] : _WAIT_MK : ALERT=1
End If
End If
End Proc
Procedure _CSAM_CLR
Sam Stop : Erase BCU
CUNAME$="Empty "
CULEN=0 : CUFREQ=0 : CUSTART=0 : CUEND=0
XSTART=-1 : XEND=-1
CHANGED=0
End Proc
Procedure _DISPLAY_CSAM
_DISPLAY_CNAME
_DISPLAY_CUFREQ : _DISPLAY_CUSTART
_DISPLAY_WAVE
End Proc
Procedure _DISPLAY_CNAME
Cls C1,8,4 To 380,12
If CULEN
A$=DIAL$(6)+CUNAME$+DIAL$(7)+Str$(CULEN)
Ink C3,C1 : Text 188-Len(A$)*4,10,A$
End If
End Proc
Procedure _DISPLAY_WAVE
Cls 0,XWAVE,YWAVE-SYWAVE To XWAVE+SXWAVE+1,YWAVE+SYWAVE
XSTART=-1 : XEND=-1
If CULEN
Ink C3,C3 : Draw XWAVE,YWAVE To XWAVE+SXWAVE,YWAVE
AD=Start(BCU)
S=(CULEN*64)/SXWAVE
Plot XWAVE,YWAVE : A=0
Repeat
P=Peek(AD+A/256)
X=XWAVE+((A/256)*SXWAVE)/CULEN
If P<128
Draw To X,YWAVE+(P*SYWAVE)/128
Else
Draw To X,YWAVE+((P-256)*SYWAVE)/128
End If
A=A+S
Until A/256>CULEN
End If
End Proc
Procedure _DISPLAY_CUFREQ
Cls C1,8,164 To 124,172
If CULEN
A$=Str$(CUFREQ)+DIAL$(8)
Ink C3,C1 : Text 64-Len(A$)*4,170,A$
End If
End Proc
Procedure _DISPLAY_CUSTART
Set Zone 26,XWAVE,YWAVE To XWAVE+SXWAVE/2,YWAVE+SYWAVE
Set Zone 27,XWAVE+SXWAVE/2,YWAVE To XWAVE+SXWAVE,YWAVE+SYWAVE
If XSTART>=0 : Put Block 2 : Del Block 2 : XSTART=-1 : End If
If XEND>=0 : Put Block 3 : Del Block 3 : XEND=-1 : End If
If CULEN
If CUSTART>0
XSTART=XWAVE+(CUSTART*SXWAVE)/CULEN : Get Block 2,XSTART,YWAVE-SYWAVE,16,SYWAVE*2
End If
If CUEND<CULEN
XEND=XWAVE+(CUEND*SXWAVE)/CULEN : Get Block 3,XEND,YWAVE-SYWAVE,16,SYWAVE*2
End If
Ink C2
If XSTART>=0
Draw XSTART,YWAVE-SYWAVE To XSTART,YWAVE+SYWAVE-1
Set Zone 26,XSTART,YWAVE-SYWAVE To XSTART+2,YWAVE+SYWAVE-1
End If
If XEND>=0
Draw XEND,YWAVE-SYWAVE To XEND,YWAVE+SYWAVE-1
Set Zone 27,XEND,YWAVE-SYWAVE To XEND+2,YWAVE+SYWAVE-1
End If
Ink C3,C1
A$=DIAL$(9)+Str$(CUSTART) : Text 168,146,A$+String$(" ",Max(0,10-Len(A$)))
A$=DIAL$(10)+Str$(CULEN-CUEND)+" " : Text 168,162,A$+String$(" ",Max(0,10-Len(A$)))
Else
Cls C1,168,140 To 168+80,148
Cls C1,168,156 To 168+80,156+8
End If
End Proc
Procedure _DEL_BANK
SB_ERASALL : LBANK=0 : PBANK=1 : SELSAM=-1 : BNAME$=""
End Proc
Procedure _INFO[A$]
Cls C1,XINF,YINF To XINF+SXINF,YINF+SYINF
Ink C3,C1
If A$=""
A$=DIAL$(1)+Str$(Chip Free)+" - "+DIAL$(2)+Str$(Fast Free)
If Chip Free+Fast Free<32*1024
A$=A$+" - "+DIAL$(37)
End If
End If
Text 320-Len(A$)*4,YINF+6,A$
End Proc
Procedure _FSEL[F$,T1$,T2$]
If Chip Free>32000
F$=Fsel$(F$,"",T1$,T2$)
Else
Screen Open 7,640,24,2,Hires
Colour 1,$FFF
Centre ">>> Low-memory file selector! <<<"
Centre At(,1)+"You *MUST* free some memory now!"
Centre At(,2)+"...press any key..."
Wait Key
Cls : Centre At(,0)+T1$ : Locate 0,1 : Input "Enter name >";F$
Screen Close 7
End If
End Proc[F$]
Procedure _SCROLL_UP
Screen Copy 0,XBANK*8,YBANK*8+8,(XBANK+SXBANK)*8,(YBANK+SYBANK)*8 To 0,XBANK*8,YBANK*8
PBANK=PBANK+1 : _DISPLAY_BSAM[PBANK+SYBANK-1]
_DISPLAY_SLIDER[C6]
End Proc
Procedure _SCROLL_DOWN
Screen Copy 0,XBANK*8,YBANK*8,(XBANK+SXBANK)*8,(YBANK+SYBANK-1)*8 To 0,XBANK*8,YBANK*8+8
PBANK=PBANK-1 : _DISPLAY_BSAM[PBANK]
_DISPLAY_SLIDER[C6]
End Proc
Procedure _DIALOG[A1$,A2$,F]
YY=48 : _UNPACK_DIALOG[YY,4]
Ink C3,C1
If A2$=""
Text 48,YY+22,A1$
Else
Text 48,YY+18,A1$ : Text 48,YY+26,A2$
End If
If F
MN$(1)=" 39528052064032" : _DISPLAY_MN[1,0]
Else
MN$(1)=" 37464052064032" : MN$(2)=" 38528052064032" : _DISPLAY_MN[1,0] : _DISPLAY_MN[2,0]
End If
Wait 20 : _WAIT_NOMK
Do
_MOUSE
If MK=1 and MZ>0 and MZ<3
_DISPLAY_MN[MZ,1] : _WAIT_NOMK : _DISPLAY_MN[MZ,0] : R=2-MZ : Exit
End If
Loop
Reset Zone 1 : Reset Zone 2
_ERASE_DIALOG
End Proc[R]
Procedure _UNPACK_DIALOG[Y,N]
Get Block 1,16,Y-2,624,Y+N*8+9 : BLOC=1
Cls 0,30,Y-1 To 610,Y+N*8+9
_UNPACK[29,32,Y]
Screen Copy 0,48,Y,384+32,Y+16 To 0,240,Y
If N>1
Screen Copy 0,32,Y+12,608,Y+16 To 0,32,Y+4+N*8
For NN=1 To N
Screen Copy 0,32,Y+4,608,Y+12 To 0,32,Y-4+NN*8
Next
End If
Locate 3,Y/8+1
End Proc[Y]
Procedure _ERASE_DIALOG
If BLOC : Put Block 1 : Del Block 1 : BLOC=0 : End If
End Proc
Procedure _LEDIT[ED$,XC,XX,YY,SX]
While Inkey$<>"" : Wend
PX=0 : L=Len(ED$) : If L>=SX : PX=L-SX : End If
XC=Max(0,XC) : XC=Min(XC,L)
Curs On
Do
Gosub _DED
Repeat
A$=Inkey$ : S=Scancode
If Mouse Key=1
X=(X Screen(X Mouse))/8-XX
If X>=0 and X<=L : XC=X : Gosub _DED : Wait Vbl : End If
End If
Until A$<>""
F=1
If A$=Chr$(13) : Exit : End If
If A$=Chr$(27) : ED$="_Esc_" : Exit : End If
If S=65 and XC+PX>0
ED$=Left$(ED$,XC+PX-1)+Mid$(ED$,PX+XC+1) : E=1 : L=L-1
S=79
End If
If S=70 and XC+PX<L
ED$=Left$(ED$,XC+PX)+Mid$(ED$,PX+XC+2) : E=1 : L=L-1 : F=0
End If
If S=79 and PX+XC>0
F=0
If XC=0
PX=PX-1
Else
XC=XC-1
End If
End If
If S=78 and PX+XC<L
F=0
If XC=SX
PX=PX+1
Else
XC=XC+1
End If
End If
If F
If A$>=" "
ED$=Left$(ED$,PX+XC)+A$+Mid$(ED$,PX+XC+1) : L=L+1
If L>SX
If XC>=SX
PX=PX+1
Else
XC=XC+1
End If
Else
XC=XC+1
End If
End If
End If
Loop
Curs Off
Goto _END
_DED:
Locate XX,YY : Print Mid$(ED$,PX+1,SX);
If E : If X Curs<XX+SX : Print " "; : E=0 : End If : End If
Locate Min(XX+XC,XX+SX-1),YY
Return
_END:
End Proc[ED$]
Procedure _DISC_ERROR
Close : Bell : _DIALOG[DIAL$(24),"",1]
Resume Label
End Proc
Procedure SB_RESERVE[N,L,F]
Dreg(0)=2 : Dreg(1)=N : Dreg(2)=L : Dreg(3)=F : Call Start(LMBANK)
End Proc[Dreg(0)]
Procedure SB_ERASE[N]
Dreg(0)=3 : Dreg(1)=N : Call Start(LMBANK)
End Proc
Procedure SB_START[N]
Dreg(0)=0 : Dreg(1)=N : Call Start(LMBANK)
End Proc[Dreg(0)]
Procedure SB_LENGTH[N]
Dreg(0)=1 : Dreg(1)=N : Call Start(LMBANK)
End Proc[Dreg(0)]
Procedure SB_ERASALL
Dreg(0)=4 : Call Start(LMBANK)
End Proc
Procedure SB_INSERT[N]
Dreg(0)=5 : Dreg(1)=N : Call Start(LMBANK)
End Proc
Procedure SB_DELETE[N]
Dreg(0)=6 : Dreg(1)=N : Call Start(LMBANK)
End Proc
Procedure _GRAB_FIND[C$]
If Prg Under
For B=1 To 512
If Blength(B)
If Peek$(Bstart(B)-8,8)=C$
BB=B : Exit
End If
End If
Next
End If
End Proc[BB]
Procedure _GRAB_BANK[B]
ST=1
NBANK=B
AB=Bstart(NBANK) : NN=Deek(AB)
AO=AB+2
NB=0
For N=0 To NN-1
_INFO[">>> Grabbing sample #"+Str$(N+ST)+" <<<"]
If Leek(AO+N*4)
AG=AB+Leek(AO+N*4)
SZ=Leek(AG+10)
If Chip Free+Fast Free<32*1024 : Bell : _INFO[DIAL$(34)+DIAL$(39)] : _WAIT_MK : Exit : End If
SB_RESERVE[N+ST,SZ+16,0] : If Param=0 : Bell : _INFO[DIAL$(34)+DIAL$(39)] : _WAIT_MK : Exit : End If
AC=Param
Copy AG,AG+14 To AC : AC=AC+14
Copy AG,AG+SZ To AC
End If
Inc NB
Next
LBANK=LBANK+NB
BCHANGED=0
End Proc[NB]
Procedure _GRAB_SEND[B]
If LBANK
S=2+LBANK*4
For N=1 To LBANK
SB_START[N] : If Param : Add S,Leek(Param+10)+14 : End If
Next
Trap Reserve As Chip Data B,S
If Errtrap : Pop Proc[0] : End If
AB=Start(B)
Poke$ AB-8,"Samples "
Doke AB,LBANK
AO=AB+2 : AG=AB+2+LBANK*4
For N=0 To LBANK-1
SB_START[N+1]
If Param
Loke AO+N*4,AG-AB
AC=Param : SZ=Leek(AC+10) : Copy AC,AC+14+SZ To AG
Add AG,14+SZ
Else
Loke AO+N*4,0
End If
Next
End If
Trap Bsend B
Trap Erase B
End Proc[-1]
Procedure PQUIT
Trap Fade 1 : Wait 16
Trap Screen Close 0
Erase BCU
Edit
End Proc